home *** CD-ROM | disk | FTP | other *** search
/ MACD 5 / MACD 5.bin / internet / irc_i_dodatki / eggdrop / eggdrop11.lha / scripts / ques3.tcl < prev    next >
Text File  |  1997-01-15  |  7KB  |  179 lines

  1. #
  2. # quesedilla, by robey
  3. # v1 -- 20aug95
  4. # v2 -- 2oct95   [improved it]
  5. # v3 -- 17mar96  [fixed it up for 1.0 multi-channel]
  6. # this will create an html file every so often (the default is once every
  7. # 5 minutes).  the html file will have a table showing the people currently
  8. # on the channel, their user@hosts, who's an op, and who's idle.  it
  9. # uses a table which some browsers (and pseudo-browsers like lynx) can't
  10. # see, but it can optionally make a second page which will support these
  11. # archaic browsers.  browsers supporting push-pull will receive the updated
  12. # page automatically periodically.
  13. #
  14. # if you have a "url" field defined for a user, their nickname in the
  15. # table will be a link pointing there.  otherwise it checks the info
  16. # line and comment field to see if they start with "http://" -- if so,
  17. # that link will be used.  as a last resort, it will make a "mailto:"
  18. # link if an email address is recorded for the user.
  19. #
  20. # feel free to modify and play with this.  the original was written in
  21. # 15 minutes, then at various times i fixed bugs and added features.
  22. # softlord helped me make the design look a little nicer. :)  if you make
  23. # any nifty improvements, please let me know.
  24. #                                       robey@netcom.com
  25.  
  26.  
  27. ## this line makes sure other scripts won't interfere
  28. catch {unset webfile}
  29.  
  30. ## for each channel you want a webfile for, do this:
  31. set webfile(#turtle) "/home/robey/public_html/turtle.html"
  32. set webfile(#gloom) "/home/robey/public_html/gloom.html"
  33.  
  34. ## define these for channels you want alternate (lynx-friendly) web pages
  35. ## for:  (the 'lynxfilerf' needs to be relative to your html directory)
  36. set lynxfile(#turtle) "/home/robey/public_html/turtle-lynx.html"
  37. set lynxfilerf(#turtle) "turtle-lynx.html"
  38.  
  39. ## how often should these html files get updated?
  40. ## (1 means once every minute, 5 means once every 5 minutes, etc)
  41. set web_update 5
  42.  
  43. ## this will help people figure out what timezone you're in :)
  44. set webtz [clock format 0 -format %Z]
  45. ## if that line breaks, you're using an older Tcl library and will have to
  46. ## set it manually like so:
  47. #set webtz "PST"
  48.  
  49.  
  50. proc do_ques {} {
  51.   global webfile lynxfile web_update botnick webtz lynxfilerf
  52.   foreach chan [array names webfile] {
  53.     if {[lsearch -exact [string tolower [channels]] [string tolower $chan]] == -1} {continue}
  54.     set fd [open $webfile($chan) w]
  55.     if {[info exists lynxfile($chan)]} {
  56.       set fdl [open $lynxfile($chan) w]
  57.     } else {
  58.       set fdl [open "/dev/null" w]
  59.     }
  60.     puts $fd "<meta http-equiv=\"Refresh\" content=[expr $web_update *60]>"
  61.     if {![onchan $botnick $chan]} {
  62.       puts $fd "<html><head><title>People on $chan right now</title></head>"
  63.       puts $fd "<body><h1>Oops!</h1><p>"
  64.       puts $fd "I'm not on $chan right now for some reason.<br>"
  65.       puts $fd "IRC isn't a very stable place these days... Please try again"
  66.       puts $fd "later!<p></body></html>"
  67.       puts $fdl "<html><head><title>People on $chan right now</title></head>"
  68.       puts $fdl "<body><h1>Oops!</h1><p>"
  69.       puts $fdl "I'm not on $chan right now for some reason.<br>"
  70.       puts $fdl "IRC isn't a very stable place these days... Please try again"
  71.       puts $fdl "later!<p></body></html>"
  72.       close $fd
  73.       close $fdl
  74.     } {
  75.       puts $fd "<html><head><title>People on $chan right now</title></head>"
  76.       puts $fd "<body><center><h1>$chan</h1>"
  77.       puts $fdl "<html><head><title>People on $chan right now</title></head>"
  78.       puts $fdl "<body><h1>$chan</h1>"
  79.       if {[info exists lynxfile($chan)]} {
  80.         puts $fd "<p>If this page looks screwy on your browser, try"
  81.         puts $fd "<a href=\"$lynxfilerf($chan)\">this page</a>.<p>"
  82.       }
  83.       puts $fd "<table border=1 cellpadding=4>"
  84.       puts $fd "<caption>People on $chan as of [date] [time] $webtz</caption>"
  85.       puts $fd "<th align=left>Nickname<th align=left>Status"
  86.       puts $fd "<th align=left>User@Host"
  87.       puts $fdl "<em>People on $chan as of [date] [time] $webtz</em><pre>"
  88.       puts $fdl "Nickname  Status           User@Host"
  89.       foreach i [chanlist $chan] {
  90.         puts $fd "<tr>"
  91.         if {[isop $i $chan]} { set chop "op"} { set chop "" }
  92.         if {[getchanidle $i $chan] > 10} {
  93.           if {$chop == ""} { set chop "idle" } { set chop "${chop}, idle" }
  94.         }
  95.         set handle [finduser $i![getchanhost $i $chan]]
  96.         if {[onchansplit $i $chan]} {
  97.           if {$chop == ""} { 
  98.             set chop "<strong>(split)</strong>"
  99.           } {
  100.             set chop "${chop} <strong>(split)</strong>"
  101.           }
  102.         }
  103.         set url [user-get $handle url]
  104.         set info [getinfo $handle]
  105.         set comment [getcomment $handle]
  106.         if {"" == $chop} { set chop "-" }
  107.         set link ""
  108.         if {"" != $url} {
  109.           set link "<a href=\"$url\">"
  110.         }
  111.         if {("" == $link) && 
  112.             ([string compare [string range $comment 0 6] "http://"] == 0)} {
  113.           set link "<a href=\"[lindex [split $comment] 0]\">"
  114.         }
  115.         if {("" == $link) &&
  116.             ([string compare [string range $info 0 6] "http://"] == 0)} {
  117.           set link "<a href=\"[lindex [split $info] 0]\">"
  118.         }
  119.         if {"" == $link} {
  120.           set email [getemail $handle]
  121.           if {("" != $email) && ([string first @ $email] > 0)} {
  122.             set link "<a href=\"mailto:$email\">"
  123.           }
  124.         }
  125.         if {"" != $link} { set elink "</a>" } { set elink "" }
  126.         puts $fd "<td align=left>${link}${i}${elink}</td>"
  127.         puts $fd "<td align=left>${chop}</td>"
  128.         set chost [getchanhost $i $chan]
  129.         if {[string compare [string tolower $i] [string tolower $botnick]] == 0} {
  130.           set chost "<em>This is me, the channel bot.</em>"
  131.           set info ""
  132.         } {
  133.           if {[matchattr $handle b]} {
  134.             set chost "<em>This is another channel bot.</em>"
  135.             set info ""
  136.           }
  137.         }
  138.         puts $fd "<td align=left>${chost}</td>"
  139.         puts $fdl "${link}[format %-9s $i]${elink} [format %-16s $chop] $chost"
  140.         if {"" != $info} {
  141.           puts $fd "<tr><td></td><td colspan=2><strong>Info:</strong> $info</td>"
  142.           puts $fdl "   <strong>Info:</strong> $info"
  143.         }
  144.       }
  145.       puts $fd "</table></center>"
  146.       puts $fdl "</pre>"
  147.       puts $fd "<p><hr><address>Created by quesedilla v3 via"
  148.       puts $fd "<a href=\"http://www.calweb.com/~xerxes/eggdrop/\">"
  149.       puts $fd "eggdrop</a></address>"
  150.       puts $fdl "<p><hr><address>Created by quesedilla v3 via"
  151.       puts $fdl "<a href=\"http://www.calweb.com/~xerxes/eggdrop/\">"
  152.       puts $fdl "eggdrop</a></address>"
  153.       puts $fd "<address>This page is automatically refreshed.</address>"
  154.       puts $fd "</body></html>"
  155.       puts $fdl "</body></html>"
  156.       close $fd
  157.       close $fdl
  158.     }
  159.   }
  160.   timer $web_update do_ques
  161. }
  162.  
  163. if {![info exists ques_going]} {
  164.   timer $web_update do_ques
  165.   set ques_going 1
  166. }
  167. set xxchans ""
  168. foreach i [array names webfile] {
  169.   set xxchans "$xxchans $i"
  170.   if {![info exists lynxfile($i)]} {
  171.     set xxchans "$xxchans (no lynx)"
  172.   }
  173.   set xxchans "${xxchans},"
  174. }
  175. set xxchans [string trimright $xxchans ","]
  176. putlog "Quesedilla v3:$xxchans"
  177. unset xxchans
  178.